home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok37.lha / Menugenerator / makeMenu.mod < prev    next >
Text File  |  1993-08-15  |  11KB  |  389 lines
  1. (* ------------------------------------------------------------------------
  2.   :Program.       makeMenu.mod
  3.   :Author.        Stefan Kraus
  4.   :Address.       Am Rehsprung 20, 6113 Babenhausen
  5.   :Phone.         06073/2656
  6.   :Version.       1.1
  7.   :Copyright.     Shareware
  8.   :Language.      Modula-2
  9.   :Translator.    M2Amiga 3.3d
  10.   :Contents.      erzeugt Modula-2 Code
  11. ------------------------------------------------------------------------ *)
  12. IMPLEMENTATION MODULE makeMenu;
  13.  
  14. FROM FileSystem  IMPORT File, Lookup, Close, WriteBytes, WriteChar;
  15. FROM SYSTEM      IMPORT ADR;
  16. FROM datstruk    IMPORT String, ItemPtr, FensterPtr, SubItemPtr;
  17. FROM Str         IMPORT Concat,Length;
  18. FROM Conversions IMPORT ValToStr;
  19. FROM Intuition   IMPORT WindowPtr;
  20.  
  21.  
  22. VAR file : File;
  23.     f,anf: FensterPtr;
  24.     tt,mt,ts: ItemPtr;
  25.     str  : String;
  26.     CR   : CHAR;
  27.     MenuZaehler,ItemZaehler,ItemNr,subtE,itemtE,i : INTEGER;
  28.     winPtr : WindowPtr;
  29.  
  30.  
  31. PROCEDURE Write(str: ARRAY OF CHAR);
  32.   VAR act: LONGINT;
  33. BEGIN
  34.   WriteBytes(file,ADR(str),Length(str),act);
  35. END Write;
  36.  
  37.  
  38. PROCEDURE WriteInt(zahl : INTEGER);
  39.   VAR act: LONGINT;
  40.       err: BOOLEAN;
  41. BEGIN
  42.   ValToStr(zahl,TRUE,str,10,0," ",err);
  43.   WriteBytes(file,ADR(str),Length(str),act);
  44. END WriteInt;
  45.  
  46. PROCEDURE cr;
  47. BEGIN
  48.   WriteChar(file,CR);
  49. END cr;
  50.  
  51.  
  52. PROCEDURE MacheModulKopf;
  53. BEGIN
  54.  
  55.   cr;cr;
  56.   Write("FROM SYSTEM    IMPORT ADR, LONGSET;");
  57.   cr;
  58.   Write("FROM Intuition IMPORT MenuItem,Menu,MenuItemFlags,MenuItemFlagSet,");
  59.   cr;
  60.   Write("                      IDCMPFlags, IDCMPFlagSet, SetMenuStrip,"); cr;
  61.   Write("                      ClearMenuStrip, WindowPtr, NewWindow,"); cr;
  62.   Write("                      IntuiMessage, IntuiText,");cr;
  63.   Write("                      ScreenFlags, ScreenFlagSet, WindowFlags,");cr;
  64.   Write("                      WindowFlagSet, OpenWindow, CloseWindow;"); cr;
  65.   Write("FROM Graphics  IMPORT jam1;");cr;
  66.   Write("FROM Exec      IMPORT GetMsg, ReplyMsg;");cr;
  67.   cr;
  68.   Write("VAR MenuWindowPtr  : WindowPtr;");cr;
  69.   Write("    IntuiMsg       : POINTER TO IntuiMessage;");cr;
  70.   Write("    class          : IDCMPFlagSet;");cr;
  71.   Write("    code           : CARDINAL;");cr;
  72.   Write("    Menustrip      : ARRAY[1..");
  73.   WriteInt(MenuZaehler); Write("] OF Menu;"); cr;
  74.   Write("    Item           : ARRAY[1..");
  75.   WriteInt(ItemZaehler); Write("] OF MenuItem;");cr;
  76.   Write("    ItemText       : ARRAY[1..");
  77.   WriteInt(ItemZaehler); Write("] OF IntuiText;");cr;
  78.   Write("    ok             : BOOLEAN;");cr;
  79.   Write("    MenuWindow     : NewWindow;");cr;
  80.   cr;
  81.   Write("PROCEDURE InitMenu;");cr;
  82.   Write("BEGIN");cr;
  83.   Write("WITH MenuWindow DO");cr;
  84.   Write("  leftEdge   :=0;   topEdge  :=0;");cr;
  85.   Write("  width      :=640; height   :=256;");cr;
  86.   Write("  detailPen  :=0;   blockPen :=1;");cr;
  87.   Write("  idcmpFlags :=IDCMPFlagSet{ menuPick };");cr;
  88.   Write("  flags      :=WindowFlagSet{ activate };");cr;
  89.   Write("  firstGadget:=NIL; checkMark:=NIL;");cr;
  90.   Write("  title      :=ADR('MenuWindow');");cr;
  91.   Write("  bitMap     :=NIL;");cr;
  92.   Write("  type       :=ScreenFlagSet{ wbenchScreen };");cr;
  93.   Write("END (* WITH *);");cr;
  94.  
  95. END MacheModulKopf;
  96.  
  97. PROCEDURE BildeMenuStruktur;
  98. BEGIN
  99.   ItemNr:=1;
  100.   FOR i:=1 TO MenuZaehler DO
  101.     Write("WITH Menustrip["); WriteInt(i); Write("] DO");cr;
  102.     Write("  nextMenu:=");
  103.     IF f^.next = NIL THEN
  104.       Write("NIL;");
  105.     ELSE
  106.       Write("ADR(Menustrip["); WriteInt(i+1); Write("]);");
  107.     END;
  108.     cr;
  109.     Write("  leftEdge:="); WriteInt(f^.winPtr[TRUE]^.leftEdge);
  110.     Write("; topEdge:=0;");cr;
  111.     Write("  width:=");  WriteInt(f^.winPtr[TRUE]^.width - 20);
  112.     Write("; height:=9;"); cr;
  113.     Write("  flags:={0};");cr;
  114.     Write("  menuName:=ADR('"); Write(f^.name); Write("');");cr;
  115.     Write("  firstItem:=ADR(Item["); WriteInt(ItemNr); Write("]);");cr;
  116.     Write("END (* WITH *);");cr;
  117.     cr;
  118.     ItemNr:=ItemNr + f^.AnzItem;
  119.     tt:=f^.PtoItem;
  120.     WHILE tt # NIL DO
  121.       IF tt^.SubItem # NIL THEN
  122.         ItemNr:=ItemNr + f^.PtoItem^.SubItem^.AnzItem;
  123.       END;
  124.       tt:=tt^.next;
  125.     END;
  126.     f:=f^.next;
  127.   END (* FOR *);
  128.  
  129. (* ab hier beginnt die ItemStruktur *)
  130.   f:=anf;
  131.   tt:=f^.PtoItem;
  132.   FOR i:=1 TO ItemZaehler DO
  133.     Write("WITH Item["); WriteInt(i); Write("] DO");cr;
  134.     Write("  nextItem:=");
  135.     IF tt^.next # NIL THEN
  136.       Write("ADR(Item[");
  137.       IF tt^.SubItem # NIL THEN
  138.         WriteInt(tt^.SubItem^.AnzItem + i + 1);
  139.       ELSE
  140.         WriteInt(i+1);
  141.       END;
  142.       Write("]);");
  143.     ELSE
  144.       Write("NIL;");
  145.     END;
  146.     cr;
  147.     Write("  leftEdge:=");
  148.     IF tt^.inSubItem THEN
  149.       WriteInt(mt^.SubItem^.winPtr^.leftEdge
  150.                      - f^.winPtr[TRUE]^.leftEdge - 20);
  151.     ELSE
  152.       WriteInt(f^.winPtr[FALSE]^.leftEdge - f^.winPtr[TRUE]^.leftEdge);
  153.     END;
  154.     Write("; topEdge:=");
  155.     IF tt^.inSubItem THEN
  156.       WriteInt(mt^.SubItem^.winPtr^.topEdge + subtE -
  157.                (f^.winPtr[FALSE]^.topEdge + itemtE ));
  158.       subtE:=subtE + 10;
  159.     ELSE
  160.       WriteInt(itemtE);
  161.       itemtE:=itemtE + 10;
  162.     END;
  163.     Write(";");cr;
  164.     Write("  width:=");
  165.     IF tt^.inSubItem THEN
  166.       WriteInt(mt^.SubItem^.winPtr^.width-20);
  167.     ELSE
  168.       WriteInt(f^.winPtr[FALSE]^.width-20);
  169.     END;
  170.     Write("; height:=9;");cr;
  171.     Write("  flags:=MenuItemFlagSet{highComp,itemText,itemEnabled};");cr;
  172.     Write("  mutualExclude:=LONGSET{};");cr;
  173.     Write("  itemFill:=ADR(ItemText["); WriteInt(i); Write("]);");cr;
  174.     Write("  selectFill:=NIL;");cr;
  175.     Write("  subItem:=");
  176.     IF tt^.SubItem = NIL THEN
  177.       Write("NIL;");
  178.       IF tt^.next = NIL THEN
  179.         IF tt^.inSubItem THEN
  180.           tt:=mt;
  181.           winPtr:=f^.winPtr[FALSE];
  182.           tt^.inSubItem:=FALSE;
  183.         END;
  184.         IF tt^.next = NIL THEN
  185.           f:=f^.next;
  186.           tt:=f^.PtoItem;
  187.           winPtr:=f^.winPtr[FALSE];
  188.           itemtE:=0;
  189.           subtE :=0;
  190.         ELSE
  191.           tt:=tt^.next;
  192.         END;
  193.       ELSE
  194.         tt:=tt^.next;
  195.       END;
  196.     ELSE
  197.       subtE:=0;
  198.       Write("ADR(Item["); WriteInt(i+1); Write("]);");
  199.       winPtr:=tt^.SubItem^.winPtr;
  200.       mt:=tt;
  201.       tt:=tt^.SubItem^.PtoItem;
  202.       tt^.inSubItem:=TRUE;
  203.     END;
  204.     cr;
  205.     Write("END (* WITH *); ");
  206.     cr;cr;
  207.   END (* FOR *);
  208.  
  209.   (* ab hier beginnt die Textstruktur *)
  210.   f:=anf;
  211.   tt:=f^.PtoItem;
  212.   cr;
  213.   FOR i:=1 TO ItemZaehler DO
  214.     Write("WITH ItemText["); WriteInt(i); Write("] DO");cr;
  215.     Write("  nextText:=NIL;");cr;
  216.     Write("  frontPen:=0; backPen:=0;");cr;
  217.     Write("  drawMode:=jam1;");cr;
  218.     Write("  leftEdge:=0; topEdge:=0;");cr;
  219.     Write("  iTextFont:=NIL;");cr;
  220.     Write("  iText:=ADR('"); Write(tt^.txt); Write("');");cr;
  221.     IF tt^.SubItem = NIL THEN
  222.       IF tt^.next = NIL THEN
  223.         IF tt^.inSubItem THEN
  224.           tt:=mt;
  225.           tt^.inSubItem:=FALSE;
  226.         END;
  227.         IF tt^.next = NIL THEN
  228.           f:=f^.next;
  229.           tt:=f^.PtoItem;
  230.         ELSE
  231.           tt:=tt^.next;
  232.         END;
  233.       ELSE
  234.         tt:=tt^.next;
  235.       END;
  236.     ELSE
  237.       mt:=tt;
  238.       tt:=tt^.SubItem^.PtoItem;
  239.       tt^.inSubItem:=TRUE;
  240.     END;
  241.     Write("END (* WITH *);");cr;cr;
  242.  
  243.   END (* FOR *);
  244.   Write("MenuWindowPtr:=OpenWindow(MenuWindow);");cr;
  245.   Write("ok:=SetMenuStrip(MenuWindowPtr,ADR(Menustrip[1]) );");cr;
  246.   Write("END InitMenu;");cr;
  247. END BildeMenuStruktur;
  248.  
  249.  
  250. PROCEDURE MacheHauptmodul;
  251.   VAR Mza,Iza,Sza : CARDINAL;  (* Zaehler *)
  252. BEGIN
  253.   Write("PROCEDURE MenuNum(Code : CARDINAL): CARDINAL;");cr;
  254.   Write("BEGIN");cr;
  255.   Write("  RETURN Code MOD 0020H;");cr;
  256.   Write("END MenuNum;");cr;cr;
  257.  
  258.   Write("PROCEDURE ItemNum(Code : CARDINAL): CARDINAL;");cr;
  259.   Write("BEGIN");cr;
  260.   Write("  RETURN Code DIV 0020H MOD 0040H;");cr;
  261.   Write("END ItemNum;");cr;cr;
  262.  
  263.   Write("PROCEDURE SubNum(Code : CARDINAL): CARDINAL;");cr;
  264.   Write("BEGIN");cr;
  265.   Write("  RETURN Code DIV 0800H;");cr;
  266.   Write("END SubNum;");cr;cr;
  267.  
  268.   Write("PROCEDURE MenuAbfrage;");cr;
  269.   Write("BEGIN");cr;
  270.   Write("  LOOP");cr;
  271.   Write("    IntuiMsg:=GetMsg(MenuWindowPtr^.userPort);");cr;
  272.   Write("    WHILE IntuiMsg # NIL DO");cr;
  273.   Write("      class:=IntuiMsg^.class;");cr;
  274.   Write("      code :=IntuiMsg^.code;");cr;
  275.   Write("      ReplyMsg(IntuiMsg);");cr;
  276.   Write("      IF (menuPick IN class) THEN");cr;
  277.   Write("        CASE MenuNum(code) OF");cr;
  278.   Mza:=0;
  279.   f:=anf;
  280.   WHILE f # NIL DO
  281.     Write("            ");
  282.     WriteInt(Mza);
  283.     Write(": CASE ItemNum(code) OF");cr;
  284.     tt:=f^.PtoItem;
  285.     Iza:=0;
  286.     WHILE tt # NIL DO
  287.       Write("                 ");
  288.       WriteInt(Iza);
  289.       IF tt^.SubItem = NIL THEN
  290.         Write(": (* Prozedur fuer "); Write(tt^.txt); Write(" *)     |");cr;
  291.       ELSE
  292.         Sza:=0;
  293.         Write(": CASE SubNum(code) OF");cr;
  294.         ts:=tt^.SubItem^.PtoItem;
  295.         WHILE ts # NIL DO
  296.           Write("                      ");
  297.           WriteInt(Sza);
  298.           Write(": (* Prozedur fuer "); Write(ts^.txt); Write("*)      |");cr;
  299.           ts:=ts^.next;
  300.           Sza:=Sza+1;
  301.         END;
  302.         Write("                    ELSE");cr;
  303.         Write("                    END (* CASE SubNum *);     |");cr;
  304.       END;
  305.       Iza:=Iza+1;
  306.       tt:=tt^.next;
  307.     END;
  308.     Write("               ELSE");cr;
  309.     Write("               END (* CASE ItemNum *);    |");cr;
  310.     f:=f^.next;
  311.     Mza:=Mza+1;
  312.   END;
  313.   Write("        ELSE");cr;
  314.   Write("        END (* CASE MenuNum *)   ");cr;
  315.   Write("      END (* IF *);");cr;
  316.   Write("      IntuiMsg:=GetMsg(MenuWindowPtr^.userPort);");cr;
  317.   Write("    END (* WHILE *);");cr;
  318.   Write("  END (* LOOP *);");cr;
  319.   Write("END MenuAbfrage;");cr;
  320.   cr;
  321.   Write("PROCEDURE CloseMenu;");cr;
  322.   Write("BEGIN");cr;
  323.   Write("  ClearMenuStrip(MenuWindowPtr);");cr;
  324.   Write("  CloseWindow(MenuWindowPtr);");cr;
  325.   Write("END CloseMenu;");cr;
  326.   cr;
  327.   Write("BEGIN");cr;
  328.  
  329. END MacheHauptmodul;
  330.  
  331.  
  332. PROCEDURE makeMenu(anfang: FensterPtr; Modulname: String);
  333.   VAR Mname: String;
  334. BEGIN
  335.   Mname:=Modulname;
  336.   Concat(Mname,".mod");
  337.   anf:=anfang;
  338.   Lookup(file,Mname,300,TRUE);
  339.   MenuZaehler:=0;
  340.   ItemZaehler:=0;
  341.   f:=anf;
  342.   WHILE f # NIL DO
  343.     f:=f^.next;
  344.     INC(MenuZaehler);
  345.   END;
  346.   f:=anf;
  347.   WHILE f # NIL DO
  348.     ItemZaehler:=ItemZaehler + f^.AnzItem;
  349.     tt:=f^.PtoItem;
  350.     WHILE tt # NIL DO
  351.       IF tt^.SubItem # NIL THEN
  352.         ItemZaehler:=ItemZaehler + tt^.SubItem^.AnzItem;
  353.       END;
  354.       tt:=tt^.next;
  355.     END;
  356.     f:=f^.next;
  357.   END;
  358.   f:=anf;
  359.   Write("IMPLEMENTATION MODULE ");
  360.   Write(Modulname);
  361.   Write(";");
  362.   MacheModulKopf;
  363.   BildeMenuStruktur;
  364.   MacheHauptmodul;
  365.   Write("END ");
  366.   Write(Modulname);
  367.   Write(".");
  368.   Close(file);
  369.   Mname:=Modulname;
  370.   Concat(Mname,".def");
  371.   Lookup(file,Mname,300,TRUE);
  372.   Write("DEFINITION MODULE ");
  373.   Write(Modulname);
  374.   Write(";");cr;
  375.   Write("PROCEDURE InitMenu;");cr;
  376.   Write("PROCEDURE MenuAbfrage;");cr;
  377.   Write("PROCEDURE CloseMenu;");cr;
  378.   Write("END ");
  379.   Write(Modulname);
  380.   Write(".");
  381.   Close(file);
  382. END makeMenu;
  383.  
  384.  
  385. BEGIN
  386.   CR:=CHAR(0AH);
  387.  
  388. END makeMenu.
  389.